home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 051-060 / amok59 / qsort / qsort.mod < prev    next >
Text File  |  1993-11-04  |  2KB  |  88 lines
  1. (*************************************************************************
  2.  
  3. :Program.    QSort (QuickSort-Algorithmus)
  4. :Author.     Philippe Gressly (PHILU), hartmut Goebel [hG]
  5. :Address.    Näfenhaus, CH-8926 Kappel a/Albis
  6. :History     V0.99 (1.8.91)
  7. :History     V0.99o 27 Sep 1991 [hG] ported to Oberon, LONGINT -> INTEGER
  8. :Copyright.  PD
  9. :Language.   Oberon
  10. :Translator. Amiga Oberon 2.00
  11. :Contents.   Die Prozedur (QSort) zum sortieren von Arrays.
  12.  
  13. *************************************************************************)
  14.  
  15. MODULE QSort;
  16.  
  17. TYPE
  18.   CompProc * = PROCEDURE(a,b: INTEGER): INTEGER;
  19.  
  20.   (*
  21.    * CompProc is used to compare two nodes. Its result should be:
  22.    * < 0, if a < b
  23.    * > 0, if a > b
  24.    * = 0, if both nodes are equal
  25.    *)
  26.  
  27. TYPE
  28.  SwapProc * = PROCEDURE(a,b: INTEGER);
  29.  
  30.  (* Die Prozedur soll das Element an der Stelle Nr1 mit dem
  31.   * Element an der Stelle Nr2 vertauschen.
  32.   *
  33.   * Beispiel:
  34.   *  t := Array[Nr1];
  35.   *  Array[Nr1] := Array[Nr2];
  36.   *  Array[Nr2] := t;
  37.   *
  38.   * Auch diese Prozedur muß selber geschrieben werden.
  39.   *)
  40.  
  41.  
  42. (*************************************************************************
  43.  
  44. Name    : QSort
  45. Input   : start, end: INTEGER; (* Woher bis wohin im Array soll
  46.                                 * sortiert werden.
  47.                                 *)
  48.           ACHTUNG: ist <start> größer oder gleich <end>, do wird das Array
  49.                    von nicht sortiert.
  50.  
  51.           gt: CompProc; (* Prozedur, die die Elemente vergleicht *)
  52.           swp: SwapPrc; (* Prozedur, die die Elemente vertauscht *)
  53.  
  54. *************************************************************************)
  55.  
  56. PROCEDURE QSort*(start, end: INTEGER; gt: CompProc; swp: SwapProc);
  57. VAR
  58.   i, j: INTEGER;
  59. BEGIN
  60.  
  61.   IF start >= end THEN RETURN END;
  62.  
  63.   (* Partitionierung *)
  64.   i := start + 1; j := end;
  65.   REPEAT
  66.     WHILE ~(gt(i,start)>0) AND (i < end      ) DO INC(i) END;
  67.     WHILE  (gt(j,start)>0) AND (j > start + 1) DO DEC(j) END;
  68.     IF (i < j) THEN
  69.        swp(i,j); INC(i); DEC(j)
  70.     END;
  71.   UNTIL j <= i;
  72.   IF (i = j) AND ~(gt(i,start)>0) THEN
  73.     INC(i) END;
  74.   IF i > end THEN
  75.     swp(start, end);
  76.     i := end;
  77.   END;
  78.   (* Ende der Partitionierugn *)
  79.  
  80.   IF start < i-1 THEN
  81.     QSort(start, i-1, gt, swp) END;
  82.   IF i     < end THEN
  83.     QSort(    i, end, gt, swp) END;
  84. END QSort;
  85.  
  86. END QSort.
  87.  
  88.